home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_l.arc / PROCS.ARC / permute.icn < prev    next >
Encoding:
Text File  |  1990-03-05  |  2.0 KB  |  88 lines
  1. ############################################################################
  2. #
  3. #    Name:    permute.icn
  4. #
  5. #    Title:    Permutations, combinations, and such
  6. #
  7. #    Author:    Ralph E. Griswold and Kurt A. Welgehausen
  8. #
  9. #    Date:    May 9, 1989
  10. #
  11. ############################################################################
  12. #
  13. #     These procedures produce various rearrangements of strings of
  14. #  characters:
  15. #
  16. #     comb(s,i)       generates the combinations characters from s taken
  17. #                     i at a time.
  18. #
  19. #     permute(s)      generates all the permutations of the string s.
  20. #
  21. #     menader(s,n)    produces a "meandering" string which contains all
  22. #                     n-tuples of characters of s.
  23. #
  24. #     csort(s)        produces the characters of s in lexical order.
  25. #
  26. #     ochars(s)       produces the unique characters of s in the order they
  27. #                     first appear in s.
  28. #
  29. #     schars(s)       produces the unique characters of s in lexical order.
  30. #
  31. ############################################################################
  32.  
  33. procedure comb(s,i)
  34.    local j
  35.  
  36.    if i < 1 then fail
  37.    suspend if i = 1 then !s
  38.       else s[j := 1 to *s - i + 1] || comb(s[j + 1:0],i - 1)
  39. end
  40.  
  41. procedure permute(s)
  42.    local i
  43.  
  44.    if *s = 0 then return ""
  45.    suspend s[i := 1 to *s] || permute(s[1:i] || s[i+1:0])
  46. end
  47.  
  48. procedure meander(alpha,n)
  49.    local result, t, i, c, k
  50.  
  51.    i := k := *alpha
  52.    t := n - 1
  53.    result := repl(alpha[1],t)
  54.    while c := alpha[i] do {
  55.       if find(result[-t:0] || c,result)
  56.       then i -:= 1
  57.       else {
  58.          result ||:= c
  59.          i := k
  60.          }
  61.       }
  62.    return result
  63. end
  64.  
  65. procedure csort(s)
  66.    local c, s1
  67.  
  68.    s1 := ""
  69.    every c := !cset(s) do
  70.       every find(c,s) do
  71.          s1 ||:= c
  72.    return s1
  73. end
  74.  
  75. procedure schars(s)
  76.    return string(cset(s))
  77. end
  78.  
  79. procedure ochars(w)
  80.    local out, c
  81.  
  82.    out := ""
  83.    every c := !w do
  84.     if not find(c,out) then
  85.         out ||:= c
  86.    return out
  87. end
  88.